This is the reproducible report for the paper “Social and moral psychology of COVID-19 across 69 countries.” whose data repository is at https://osf.io/tfsza/.
Please cite it as:
Azevedo, F., Pavlović, T., Rêgo, G. G. d., Ay, F. C., Gjoneska, B., Etienne, T., … Sampaio, W. M. (2022, May 18). Social and moral psychology of COVID-19 across 69 countries. https://doi.org/10.31234/osf.io/a3562
You can also download the Bibtex here.
Abstract
The COVID-19 pandemic has affected all domains of human life, including the economic and social fabric of societies. One of the central strategies for managing public health throughout the pandemic has been through persuasive messaging and collective behavior change. To help scholars better understand the social and moral psychology behind public health behavior, we present a dataset comprising of 51,404 individuals from 69 countries. This dataset was collected for the International Collaboration on Social & Moral Psychology of COVID-19 project (ICSMP COVID-19). This social science survey invited participants around the world to complete a series of individual differences and public health attitudes about COVID-19 during an early phase of the COVID-19 pandemic (between April and June 2020). The survey included seven broad categories of questions: COVID-19 beliefs and compliance behaviours; identity and social attitudes; ideology; health and well-being; moral beliefs and motivation; personality traits; and demographic variables. We report both raw and cleaned data, along with all survey materials, data visualisations, and psychometric evaluations of key variables.
Check out the paper’s ShinnyApp here and also check out our website for more information. Our preprint can be found here and here it is our data repository.
***
library(tidyverse)
'%!in%' <- function(x,y)!('%in%'(x,y))
###Function for longtable in latex format
addtorow <- list()
addtorow$pos <- list()
addtorow$pos[[1]] <- c(0)
addtorow$command <- c(paste(
"\\hline \n",
"\\endhead \n",
"\\hline \n",
"{\\footnotesize Continued on next page} \n",
"\\endfoot \n",
"\\endlastfoot \n",
sep=""))
###### functions test colors an ranging palette
##### function WES ANDERSON PALLETTES SAMPLE SIZE #####
ssize_fun_wa <- function(name_palette = "palette",
n_colors,
legend_name = "Legend\nName\nNULL*")
{
palette_wa <- wes_palette(name_palette, n_colors,
type = "continuous")
ggplot(sample_size_n) +
geom_polygon(data = world_map, aes(x = long, y = lat, group = group),
color="#ffffff00",size=0.05, fill = "gray90") +
geom_map(aes(map_id = ISO3, fill = n), map = world_map,
color="#ffffff", size=0.05) +
expand_limits(x = world_map$long, y = world_map$lat) +
coord_fixed()+
scale_x_discrete(labels = NULL, breaks = NULL) +
scale_y_discrete(labels = NULL, breaks = NULL) +
scale_fill_gradientn(colours = palette_wa,
limits = c(0, 2500),
breaks = c(0, 500, 1000, 1500, 2000, 2500),
labels = c(0, 500, 1000, 1500, 2000, 2500),
name = legend_name,
guide = guide_colorbar(
direction = "vertical",
barheight = unit(20, units = "mm"),
barwidth = unit(3, units = "mm"),
draw.ulim = F,
title.position = 'top',
# some shifting around
title.hjust = 0,
label.hjust = 0)) +
labs(x=NULL, y=NULL)+
theme_map() +
theme(text = element_text(family = "Georgia"),
legend.position = c(0.05, 0.01),legend.text.align = 0,
legend.background = element_rect(fill = alpha('white', 0.0)),
legend.text = element_text(size = 6, hjust = 0,
color = "#4e4d47"),
plot.tag.position = c(0.1, 0),
plot.tag = element_text(size = 10, hjust = 0.1, vjust = 2),
plot.title = element_text(color = "#4e4d47",
size=12, face = "bold",
vjust = 3),
plot.subtitle = element_text(color = "#4e4d47", vjust = 2,
margin = margin(b = -0.00001,
t = 0.05,
l = 2,
unit = "cm"), debug = F),
legend.title = element_text(size = 7),
plot.margin = unit(c(.1,.1,.1,.1), "cm"),
panel.spacing = unit(c(-.1,0.2,.2,0.2), "cm"),
panel.border = element_blank(),
plot.caption = element_text(size=8,
family="Georgia",color="gray35"))
}
RevCode <- function (x)
{
if (is.factor(x)) {
levels(x) <- rev(levels(x))
res <- factor(x, levels = rev(levels(x)))
}
else if (is.numeric(x)) {
res <- (min(x, na.rm=TRUE) + max(x, na.rm=TRUE) - x)
}
else if (is.logical(x)) {
res <- as.logical(1 - x)
}
else {
res <- NA
}
return(res)
}
data <- haven::read_sav("C:/Users/falaf/Dropbox/Shared/Projects/Current/ICMPS Nature SciData/ICSMP Scientific Data/Data/Final/ICSMP_cleaned_data.sav", encoding = "latin1")
nrow(data)
## [1] 51404
ncol(data)
## [1] 99
sum(table(unique(data$ISO3)))
## [1] 69
table(sjlabelled::as_label(data$ISO3))
##
## United Arab Emirates Argentina Australia
## 313 721 2161
## Austria Belgium Bangladesh
## 1605 1159 596
## Bulgaria Bolivia Brazil
## 666 29 2268
## Canada Switzerland Chile
## 963 1056 97
## China Colombia Costa Rica
## 1030 1277 25
## Cuba Germany Denmark
## 43 1587 566
## Dominican Republic Ecuador Spain
## 36 148 1090
## Finland France United Kingdom
## 698 1119 550
## Ghana Greece Guatemala
## 390 640 48
## Honduras Croatia Hungary
## 24 515 506
## India Ireland Iraq
## 741 785 1142
## Israel Italy Japan
## 1253 1282 1239
## Korea Latvia Morocco
## 555 1008 812
## Mexico Macedonia Nigeria
## 1311 726 608
## Nicaragua Netherlands Norway
## 16 1297 532
## Nepal New Zealand Pakistan
## 563 510 565
## Panama Peru Philippines
## 18 91 524
## Poland Puerto Rico Paraguay
## 1817 2 16
## Romania Russian Federation Senegal
## 1005 558 552
## Singapore El Salvador Serbia
## 564 28 1070
## Slovakia Sweden Turkey
## 1265 1568 1455
## Taiwan Ukraine Uruguay
## 833 577 49
## United States of America Venezuela South Africa
## 1506 96 939
sum(table(unique(data$country)))
## [1] 77
table(sjlabelled::as_label(data$country))
##
## United Arab Emirates Argentina Austria
## 313 721 1605
## Australia Bangladesh Belgium
## 2161 596 1159
## Bulgaria Bolivia Brazil
## 666 29 961
## Brazil_2 Brazil_3 Canada_english
## 1301 6 792
## Canada_french Switzerland Chile
## 171 1056 97
## China Colombia Colombia_2
## 1030 731 546
## Costa Rica Cuba Germany
## 25 43 1587
## Denmark Dominican Republic Ecuador
## 566 36 148
## Spain Finland France
## 1090 698 1119
## United Kingdom Ghana Greece
## 550 390 640
## Guatemala Honduras Croatia
## 48 24 515
## Hungary Ireland Israel
## 506 785 1253
## India India_2 Iraq
## 312 429 1142
## Italy Italy_2 Japan
## 998 284 1239
## Korea Latvia Morocco
## 555 1008 812
## Macedonia Mexico Mexico_2
## 726 804 507
## Nigeria Nicaragua Netherlands
## 608 16 1297
## Norway Nepal New Zealand
## 532 563 510
## Panama Peru Philippines
## 18 91 524
## Pakistan Poland Puerto Rico
## 565 1817 2
## Paraguay Romania Romania_2
## 16 500 505
## Serbia Russian Federation Sweden
## 1070 558 1568
## Singapore Slovakia Senegal
## 564 1265 552
## El Salvador Turkey Taiwan
## 28 1455 833
## Ukraine United States of America Uruguay
## 577 1506 49
## Venezuela South Africa
## 96 939
dt.noNA <- data[data$start_date %!in% NA,]
#
#as.Date(as.POSIXct(dt.noNA$start_date, format = "%Y-%m-%d"))
min(dt.noNA$end_date)
## [1] "2020-04-22"
max(dt.noNA$end_date) #390 from Ghana from "2020-06-03"
## [1] "2020-06-03"
data$sample_coding_labelled <- sjlabelled::as_label(data$sample_coding)
data$country_labelled <- sjlabelled::as_label(data$country)
# counts
table(data$sample_coding_labelled)
##
## Quota-based nationally representative Post-hoc weights
## 26173 6703
## Convenience unknown/undecided
## 18528 0
# proportion
table(data$sample_coding_labelled)/nrow(data)
##
## Quota-based nationally representative Post-hoc weights
## 0.5091627 0.1303984
## Convenience unknown/undecided
## 0.3604389 0.0000000
# per country
library(tidyverse)
data %>% group_by(country_labelled, sample_coding_labelled, ISO3, country) %>% summarize(n = n()) -> dt.sample.type
# display table
library(DT)
DT::datatable(dt.sample.type,
class = 'cell-border stripe',
filter = 'top',
escape = F,
caption = htmltools::tags$caption(style = 'caption-side: bottom; text-align: left;','Table 0: ', htmltools::em('Sample types per samples.')),
options = list(initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#2b2b2b', 'color': '#f3f4f5'});",
"}"))
)
sss <- data
sss$valid <- rowSums(is.na(sss[, -grep("employ_status2|sex2", names(sss))]))
sss$prop_valid <- 1-sss$valid/ncol(sss)
sss$Prop_50 <- ifelse(sss$prop_valid < .50, 0, 1)
sss$Prop_90 <- ifelse(sss$prop_valid < .90, 0, 1)
sss$male <- ifelse(is.na(sss$sex1), 0, ifelse(sss$sex1 == 1, 1, 0))
sss$female <- ifelse(is.na(sss$sex1), 0, ifelse(sss$sex1 == 2, 1, 0))
sss$other <- ifelse(is.na(sss$sex1), 0, ifelse(sss$sex1 == 3, 1, 0))
sss$gendna <- ifelse(is.na(sss$sex1), 1, 0)
sss$emp_ft <- ifelse(is.na(sss$employ_status1), 0, ifelse(sss$employ_status1 == 1, 1, 0))
sss$emp_pt <- ifelse(is.na(sss$employ_status1), 0, ifelse(sss$employ_status1 == 2, 1, 0))
sss$unemp <- ifelse(is.na(sss$employ_status1), 0, ifelse(sss$employ_status1 == 3, 1, 0))
sss$stud <- ifelse(is.na(sss$employ_status1), 0, ifelse(sss$employ_status1 == 4, 1, 0))
sss$ret <- ifelse(is.na(sss$employ_status1), 0, ifelse(sss$employ_status1 == 5, 1, 0))
sss$eother <- ifelse(is.na(sss$employ_status1), 0, ifelse(sss$employ_status1 == 6, 1, 0))
sss$empna <- ifelse(is.na(sss$employ_status1), 1, 0)
sss$single <- ifelse(is.na(sss$marital1), 0, ifelse(sss$marital1 == 1, 1, 0))
sss$relationship <- ifelse(is.na(sss$marital1), 0, ifelse(sss$marital1 == 2, 1, 0))
sss$married <- ifelse(is.na(sss$marital1), 0, ifelse(sss$marital1 == 3, 1, 0))
sss$marna <- ifelse(is.na(sss$marital1), 1, 0)
sss$child0 <- ifelse(is.na(sss$children), 0, ifelse(sss$children == 0, 1, 0))
sss$child1 <- ifelse(is.na(sss$children), 0, ifelse(sss$children == 1, 1, 0))
sss$child2 <- ifelse(is.na(sss$children), 0, ifelse(sss$children == 2, 1, 0))
sss$child3 <- ifelse(is.na(sss$children), 0, ifelse(sss$children == 3, 1, 0))
sss$child4 <- ifelse(is.na(sss$children), 0, ifelse(sss$children == 4, 1, 0))
sss$child5 <- ifelse(is.na(sss$children), 0, ifelse(sss$children == 5, 1, 0))
sss$child6 <- ifelse(is.na(sss$children), 0, ifelse(sss$children == 6, 1, 0))
sss$child7 <- ifelse(is.na(sss$children), 0, ifelse(sss$children == 7, 1, 0))
sss$child8 <- ifelse(is.na(sss$children), 0, ifelse(sss$children == 8, 1, 0))
sss$child9 <- ifelse(is.na(sss$children), 0, ifelse(sss$children == 9, 1, 0))
sss$child10plus <- ifelse(is.na(sss$children), 0, ifelse(sss$children == 10, 1, 0))
sss$childna <- ifelse(is.na(sss$children), 1, 0)
sss %>% group_by(country) %>% summarize(
n = n(),
Prop_50 = round(mean(Prop_50), 3),
Prop_90 = round(mean(Prop_90), 3),
M_age = round(mean(age, na.rm = T), 3),
SD_age = round(sd(age, na.rm = T), 3),
sample = DescTools::Mode(country)) %>%
mutate_if(haven::is.labelled, as_factor) %>%
arrange(as.character(sample)) -> table1
dt.sample.type %>%
group_by(ISO3) %>%
mutate(Country_frequency = n()) %>%
ungroup() -> dt.sample.type.Country_frequency
names(dt.sample.type.Country_frequency)[4] <- "sample"
table1 <- merge(table1, dt.sample.type.Country_frequency, by = "sample")
table1 <- table1[order(as.character(table1$country)),]
table1 <- table1[,c("sample", "country", "n.x", "Prop_50", "Prop_90", "M_age", "SD_age", "Country_frequency")]
names(table1)[3] <- "N"
table1[, 4:7] <- round(table1[,4:7], 2)
#means to report on paper
round(1-mean(sss$prop_valid),3)*100 #[1] 6
## [1] 6.1
round(1-mean(table1$Prop_50),3)*100 #[1] 4.4
## [1] 4.4
round(1-mean(table1$Prop_90),3)*100 #[1] 7.2
## [1] 7.1
round(sum(sss$valid==0)/nrow(sss),3)*100 #[1] 24.7
## [1] 24.8
round(prop.table(table(sss$att_check_nobots, useNA = "always")), 3)*100 #1.0 90.9 8.0
##
## 0 1 <NA>
## 1.0 90.9 8.0
DT::datatable(table1,
class = 'cell-border stripe',
filter = 'top',
escape = F,
caption = htmltools::tags$caption(style = 'caption-side: bottom; text-align: left;','Table 1: ', htmltools::em('Note: Country = country names in accordance with ISO3 codes, N = number of respondents in each country. < 50% and < 90% = average proportion of valid (non NA) answers that are below 0.5 and 0,.9 respectively in the subject level. μAge = mean age and sdAge = standard deviation of the age, Multiple datasets = whether there were multiple data collections in the country.')),
options = list(initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#2b2b2b', 'color': '#f3f4f5'});",
"}"))
)
table2 <- sss %>% group_by(country) %>% summarize(Prop_female = round(mean(female, na.rm = T), 3), Prop_male = round(mean(male, na.rm = T), 2), Prop_other = round(mean(other, na.rm = T), 2), Prop_NA = round(mean(gendna, na.rm = T), 2)) %>% mutate_if(haven::is.labelled, as_factor) %>% arrange(as.character(country))
DT::datatable(table2,
class = 'cell-border stripe',
filter = 'top',
escape = F,
caption = htmltools::tags$caption(style = 'caption-side: bottom; text-align: left;','Table 2: ', htmltools::em('Note: Country = country names in accordance with ISO3 codes, % Female = Proportion of female respondents in the country, % Male = proportion of male respondents, % Other = proportion of non-binary respondents and % NA = proportion of the unreported sex.')),
options = list(initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#2b2b2b', 'color': '#f3f4f5'});",
"}"))
)
table3 <- sss %>% group_by(country) %>% summarize(Prop_ft_employed = mean(emp_ft, na.rm = T), Prop_pt_employed = mean(emp_pt, na.rm = T), Prop_unemployed = mean(unemp, na.rm = T), Prop_student = mean(stud, na.rm = T), Prop_retired = mean(ret, na.rm = T), Prop_other = mean(eother, na.rm = T), Prop_NA = mean(empna, na.rm = T)) %>% mutate_if(haven::is.labelled, as_factor) %>% arrange(as.character(country))
table3[, 2:8] <- round(table3[,2:8], 2)
DT::datatable(table3,
class = 'cell-border stripe',
filter = 'top',
escape = F,
caption = htmltools::tags$caption(style = 'caption-side: bottom; text-align: left;','Table 3: ', htmltools::em('Note: Country = country names in accordance with ISO3 codes, % Full = Proportion of full time workers, % Part = proportion of part time workers, % Unemp. = proportion of unemployed respondents, % Student = proportion of students, % Retired = proportion of retirees, % Other = proportion of respondents who do not fit in the mentioned categories and % NA = proportion of the unreported employment status.')),
options = list(initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#2b2b2b', 'color': '#f3f4f5'});",
"}"))
)
table4 <- sss %>% group_by(country) %>% summarize(Prop_single = mean(single, na.rm = T), Prop_relationship = mean(relationship, na.rm = T), Prop_married = mean(married, na.rm = T), Prop_married_NA = mean(marna, na.rm = T), Prop_child_0 = mean(child0, na.rm = T), Prop_child_1 = mean(child1, na.rm = T), Prop_child_2 = mean(child2, na.rm = T), Prop_child_3 = mean(child3, na.rm = T), Prop_child_4 = mean(child4, na.rm = T), Prop_child_5 = mean(child5, na.rm = T), Prop_child_6 = mean(child6, na.rm = T), Prop_child_7 = mean(child7, na.rm = T), Prop_child_8 = mean(child8, na.rm = T), Prop_child_9 = mean(child9, na.rm = T), Prop_child_10plus = mean(child10plus, na.rm = T), Prop_NA = mean(childna, na.rm = T)) %>% mutate_if(haven::is.labelled, as_factor) %>% arrange(as.character(country))
t4.pap<-table4
t4.pap$over_4<-t4.pap$Prop_child_5+t4.pap$Prop_child_6+t4.pap$Prop_child_7+t4.pap$Prop_child_8+t4.pap$Prop_child_9+t4.pap$Prop_child_10plus
t4.pap$Prop_child_5<-NULL
t4.pap$Prop_child_6<-NULL
t4.pap$Prop_child_7<-NULL
t4.pap$Prop_child_8<-NULL
t4.pap$Prop_child_9<-NULL
t4.pap$Prop_child_10plus<-NULL
t4.pap<-t4.pap[,c("country","Prop_single","Prop_relationship", "Prop_married", "Prop_married_NA", "Prop_child_0","Prop_child_1","Prop_child_2","Prop_child_3","Prop_child_4","over_4", "Prop_NA")]
table4 <- t4.pap
table4[, 2:12] <- round(table4[,2:12], 2)
DT::datatable(table4,
class = 'cell-border stripe',
filter = 'top',
escape = F,
caption = htmltools::tags$caption(style = 'caption-side: bottom; text-align: left;','Table 4: ', htmltools::em('Note: Country = country names in accordance with ISO3 codes, Columns 2-5 shows the proportion of different marital status, NA(MS) = unreported marital status, Columns 6-16 shows proportion of respondents by the number of children they have and NA(Child.) = proportion of unreported number of children.')),
options = list(initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#2b2b2b', 'color': '#f3f4f5'});",
"}"))
)
data %>%
group_by(sample_coding) %>%
dplyr::summarise(Samples = paste0(unique(country), collapse = ", "),
N_samples = n_distinct(country),
N_respondents = n(),) %>%
dplyr::mutate(Prop_countries = round(N_samples / sum(N_samples), 2),
Prop_respondents = round(N_respondents / sum(N_respondents), 2)) -> table5
# label sample coding types
table5$sample_coding <- as.character(sjlabelled::as_label(table5$sample_coding))
table5[4,] <- list("Total", "",
sum(table5$N_samples),
sum(table5$N_respondents),
sum(table5$Prop_countries),
sum(table5$Prop_respondents))
DT::datatable(table5,
class = 'cell-border stripe',
filter = 'top',
escape = F,
caption = htmltools::tags$caption(style = 'caption-side: bottom; text-align: left;','Table 5: ', htmltools::em('Note: .')),
options = list(initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#2b2b2b', 'color': '#f3f4f5'});",
"}"))
)
## Creating mean scores
#--------------------------
#
# 1. conspiracy theories
ctheory = c("ctheory1","ctheory2","ctheory3","ctheory4")
data$ctheory_index = rowMeans(data[,names(data) %in% ctheory], na.rm = F)
# 2. morality as cooperation
#data$mcoop6_rev = RevCode(data$mcoop6)
#data$mcoop7_rev = RevCode(data$mcoop7)
#mcoop = c("mcoop1","mcoop2","mcoop3","mcoop4","mcoop5","mcoop6_rev","mcoop7_rev")
mcoop = c("mcoop1","mcoop2","mcoop3","mcoop4","mcoop5","mcoop6","mcoop7")
data$mcoop_index = rowMeans(data[,names(data) %in% mcoop], na.rm = F)
# 3. spatial distancing
data$contact2_rev = RevCode(data$contact2)
contact = c("contact1","contact2_rev","contact3","contact4","contact5")
data$contact_index = rowMeans(data[,names(data) %in% contact], na.rm = F)
# 4. collective narcissism
cnarc = c("cnarc1","cnarc2","cnarc3")
data$cnarc_index = rowMeans(data[,names(data) %in% cnarc], na.rm = T)
# 5. national identity | only two items
nidentity = c("nidentity1","nidentity2")
data$nidentity_index = rowMeans(data[,names(data) %in% nidentity], na.rm = F)
# 6. policy support
psupport = c("psupport1","psupport2","psupport3","psupport4","psupport5")
data$psupport_index = rowMeans(data[,names(data) %in% psupport], na.rm = F)
# 7. hygiene
hygiene = c("hygiene1","hygiene2","hygiene3","hygiene4","hygiene5")
data$hygiene_index = rowMeans(data[,names(data) %in% hygiene], na.rm = F)
# 8. moral identity
data$moralid4_rev = RevCode(data$moralid4)
data$moralid7_rev = RevCode(data$moralid7)
moralid = c("moralid1","moralid10","moralid2","moralid3","moralid4_rev","moralid5","moralid6","moralid7_rev","moralid8","moralid9")
data$moralid_index = rowMeans(data[,names(data) %in% moralid], na.rm = F)
# 9. narcissism
narc = c("narc1","narc2","narc3","narc4","narc5","narc6")
data$narc_index = rowMeans(data[,names(data) %in% narc], na.rm = F)
# 10. open mindedness
data$omind1_rev = RevCode(data$omind1)
data$omind5_rev = RevCode(data$omind5)
data$omind6_rev = RevCode(data$omind6)
omind = c("omind1_rev","omind2","omind3","omind4","omind5_rev","omind6_rev")
data$omind_index = rowMeans(data[,names(data) %in% omind], na.rm = F)
# 11. optimism
optim = c("optim1","optim2")
data$optim_index = rowMeans(data[,names(data) %in% optim], na.rm = F)
# 12. risk perception
riskperc = c("riskperc1","riskperc2")
data$riskperc_index = rowMeans(data[,names(data) %in% riskperc], na.rm = F)
# 13. social belonging
sbelong = c("sbelong1","sbelong2","sbelong3","sbelong4")
data$sbelong_index = rowMeans(data[,names(data) %in% sbelong], na.rm = F)
# 14. self-control
data$slfcont3_rev = RevCode(data$slfcont3)
data$slfcont4_rev = RevCode(data$slfcont4)
slfcont = c("slfcont1","slfcont2","slfcont3_rev","slfcont4_rev")
data$slfcont_index = rowMeans(data[,names(data) %in% slfcont], na.rm = F)
#
#
# To calculate reliability indices, two conditions need to be satisfied
#
# 1. Enough records per country
#-----------------------------------
# This paper (https://www.sciencedirect.com/science/article/abs/pii/S0092656619300297) suggests maintaining n>490 as a minimum for correlation analysis, depending on population correlation and internal consistency. We show that our average omega consistency for six of our constructs ranges between 0.74 and 0.90, and correlation between all 14 constructs ranges between 0.003 and 0.48, averaging 0.17. We will therefore respect n=490 as a minimum here.
min_n = 490
ISO3_n = as.data.frame(table(data$ISO3))
small_n_ISO = as.vector(ISO3_n$Var1[ISO3_n$Freq<min_n])
inclusion2 = (data$ISO3 %!in% small_n_ISO)
# sum(inclusion2, na.rm = T) # 49935
# 2. Passed attention check
#----------------------------------
## data$att_check_nobots==1
inclusion3 = (data$att_check_nobots==1 & !is.na(data$att_check_nobots))
#sum(inclusion3, na.rm = T) # 46745
#
#
# Apply criteria and subset data
#--------------------------------
# which of the following inclusion criteria should be used; T if used, F if not used
prop75 = F
large_n = T
attn_check = T
prop75vec = if(prop75) {inclusion1}else{rep(T, nrow(data))}
largenvec = if(large_n) {inclusion2}else{rep(T, nrow(data))}
attnvec = if(attn_check){inclusion3}else{rep(T, nrow(data))}
inclusion_corr = prop75vec & largenvec & attnvec
# sum(inclusion_corr) # how many records are retained: 45792
data_cleaned = data[inclusion_corr,]
#
#
#
indices6 = c("ctheory_index", "mcoop_index", "contact_index", "cnarc_index", "nidentity_index", "psupport_index")
# create empty df
consistency = data.frame(ISO3 = rep(unique(data_cleaned$ISO3), each=4),
measure = rep(c("alpha","omega","guttman","variance")),
measure_label = rep(c("Cronbach's alpha","Omega","Guttman's split-half coefficient","Proportion of variance explained")),
ctheory = NA,
mcoop = NA,
contact = NA,
cnarc = NA,
nidentity = NA,
psupport = NA)
library(psych)
for(i in 1:length(unique(data_cleaned$ISO3))){
# select country data
country = unique(data_cleaned$ISO3)[i]
data_selection = data_cleaned[data_cleaned$ISO3 == country,]
# ctheory ####
# alpha
alpha_pos = which(consistency$ISO3 == country & consistency$measure == "alpha")
alpha = round(psych::alpha(data_selection[,names(data_selection) %in% ctheory])$total$std.alpha, 2)
# omega
omega_pos = which(consistency$ISO3 == country & consistency$measure == "omega")
omega = round(psych::omega(data_selection[,names(data_selection) %in% ctheory],nfactors = 1)$omega_h, 2)
# guttman split half
split_pos = which(consistency$ISO3 == country & consistency$measure == "guttman")
split = round(psych::splitHalf(data_selection[,names(data_selection) %in% ctheory])$maxrb, 2)
# fa variance
fa_var_pos = which(consistency$ISO3 == country & consistency$measure == "variance")
fa_var = round(psych::fa(data_selection[,names(data_selection) %in% ctheory], fa=1)$Vaccounted[2], 2)
# fill in
consistency$ctheory[alpha_pos] = alpha
consistency$ctheory[omega_pos] = omega
consistency$ctheory[split_pos] = split
consistency$ctheory[fa_var_pos] = fa_var
# mcoop ####
# alpha
alpha_pos = which(consistency$ISO3 == country & consistency$measure == "alpha")
alpha = round(psych::alpha(data_selection[,names(data_selection) %in% mcoop])$total$std.alpha, 2)
# omega
omega_pos = which(consistency$ISO3 == country & consistency$measure == "omega")
omega = round(psych::omega(data_selection[,names(data_selection) %in% mcoop],nfactors = 1)$omega_h, 2)
# guttman split half
split_pos = which(consistency$ISO3 == country & consistency$measure == "guttman")
split = round(psych::splitHalf(data_selection[,names(data_selection) %in% mcoop])$maxrb, 2)
# fa variance
fa_var_pos = which(consistency$ISO3 == country & consistency$measure == "variance")
fa_var = round(psych::fa(data_selection[,names(data_selection) %in% mcoop], fa=1)$Vaccounted[2], 2)
# fill in
consistency$mcoop[alpha_pos] = alpha
consistency$mcoop[omega_pos] = omega
consistency$mcoop[split_pos] = split
consistency$mcoop[fa_var_pos] = fa_var
# contact ####
# alpha
alpha_pos = which(consistency$ISO3 == country & consistency$measure == "alpha")
alpha = round(psych::alpha(data_selection[,names(data_selection) %in% contact])$total$std.alpha, 2)
# omega
omega_pos = which(consistency$ISO3 == country & consistency$measure == "omega")
omega = round(psych::omega(data_selection[,names(data_selection) %in% contact],nfactors = 1)$omega_h, 2)
# guttman split half
split_pos = which(consistency$ISO3 == country & consistency$measure == "guttman")
split = round(psych::splitHalf(data_selection[,names(data_selection) %in% contact])$maxrb, 2)
# fa variance
fa_var_pos = which(consistency$ISO3 == country & consistency$measure == "variance")
fa_var = round(psych::fa(data_selection[,names(data_selection) %in% contact], fa=1)$Vaccounted[2], 2)
# fill in
consistency$contact[alpha_pos] = alpha
consistency$contact[omega_pos] = omega
consistency$contact[split_pos] = split
consistency$contact[fa_var_pos] = fa_var
# cnarc ####
# alpha
alpha_pos = which(consistency$ISO3 == country & consistency$measure == "alpha")
alpha = round(psych::alpha(data_selection[,names(data_selection) %in% cnarc])$total$std.alpha, 2)
# omega
omega_pos = which(consistency$ISO3 == country & consistency$measure == "omega")
omega = round(psych::omega(data_selection[,names(data_selection) %in% cnarc],nfactors = 1)$omega_h, 2)
# guttman split half
split_pos = which(consistency$ISO3 == country & consistency$measure == "guttman")
split = round(psych::splitHalf(data_selection[,names(data_selection) %in% cnarc])$maxrb, 2)
# fa variance
fa_var_pos = which(consistency$ISO3 == country & consistency$measure == "variance")
fa_var = round(psych::fa(data_selection[,names(data_selection) %in% cnarc], fa=1)$Vaccounted[2], 2)
# fill in
consistency$cnarc[alpha_pos] = alpha
consistency$cnarc[omega_pos] = omega
consistency$cnarc[split_pos] = split
consistency$cnarc[fa_var_pos] = fa_var
# nidentity ####
# alpha
alpha_pos = which(consistency$ISO3 == country & consistency$measure == "alpha")
alpha = round(psych::alpha(data_selection[,names(data_selection) %in% nidentity])$total$std.alpha, 2)
# omega
omega_pos = which(consistency$ISO3 == country & consistency$measure == "omega")
#omega = round(psych::omega(data_selection[,names(data_selection) %in% nidentity],nfactors = 1)$omega_h, 2)
# guttman split half
split_pos = which(consistency$ISO3 == country & consistency$measure == "guttman")
split = round(psych::splitHalf(data_selection[,names(data_selection) %in% nidentity])$maxrb, 2)
# fa variance
fa_var_pos = which(consistency$ISO3 == country & consistency$measure == "variance")
fa_var = round(psych::fa(data_selection[,names(data_selection) %in% nidentity], fa=1)$Vaccounted[2], 2)
# fill in
consistency$nidentity[alpha_pos] = alpha
#consistency$nidentity[omega_pos] = omega
consistency$nidentity[split_pos] = split
consistency$nidentity[fa_var_pos] = fa_var
# psupport ####
# alpha
alpha_pos = which(consistency$ISO3 == country & consistency$measure == "alpha")
alpha = round(psych::alpha(data_selection[,names(data_selection) %in% psupport])$total$std.alpha, 2)
# omega
omega_pos = which(consistency$ISO3 == country & consistency$measure == "omega")
omega = round(psych::omega(data_selection[,names(data_selection) %in% psupport],nfactors = 1)$omega_h, 2)
# guttman split half
split_pos = which(consistency$ISO3 == country & consistency$measure == "guttman")
split = round(psych::splitHalf(data_selection[,names(data_selection) %in% psupport])$maxrb, 2)
# fa variance
fa_var_pos = which(consistency$ISO3 == country & consistency$measure == "variance")
fa_var = round(psych::fa(data_selection[,names(data_selection) %in% psupport], fa=1)$Vaccounted[2], 2)
# fill in
consistency$psupport[alpha_pos] = alpha
consistency$psupport[omega_pos] = omega
consistency$psupport[split_pos] = split
consistency$psupport[fa_var_pos] = fa_var
}
## Some items ( mcoop5 mcoop6 mcoop7 ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' optionSome items ( contact2_rev ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' optionSome items ( mcoop7 ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' optionSome items ( mcoop5 mcoop6 mcoop7 ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' optionSome items ( contact2_rev ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' optionSome items ( contact2_rev ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' optionSome items ( mcoop6 mcoop7 ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' optionSome items ( mcoop7 ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' optionSome items ( mcoop7 ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' optionSome items ( mcoop6 mcoop7 ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' optionSome items ( mcoop6 mcoop7 ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' optionSome items ( mcoop6 mcoop7 ) were negatively correlated with the total scale and
## probably should be reversed.
## To do this, run the function again with the 'check.keys=TRUE' option
#
#
#
table6 <- consistency
table6$Country <- as.character(sjlabelled::as_label(table6$ISO3))
table6 <- table6[,c("Country","measure_label", "ctheory", "mcoop", "contact", "cnarc", "nidentity", "psupport")]
names(table6) <- c("Country","measure_label", "Conspiracy beliefs","Morality as cooperation","Spatial distancing","Collective narcissism","National identity","Policy support")
DT::datatable(table6,
class = 'cell-border stripe',
filter = 'top',
escape = F,
caption = htmltools::tags$caption(style = 'caption-side: bottom; text-align: left;','Table 6: ', htmltools::em('Note: .')),
options = list(initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#2b2b2b', 'color': '#f3f4f5'});",
"}"))
)
save.image("temp.RData")
xlsx::write.xlsx(table1, "table1.xlsx")
xlsx::write.xlsx(table2, "table2.xlsx")
xlsx::write.xlsx(table3, "table3.xlsx")
xlsx::write.xlsx(table4, "table4.xlsx")
xlsx::write.xlsx(table5, "table5.xlsx")
xlsx::write.xlsx(table6, "table6.xlsx")
xfun::embed_file("table1.xlsx")
xfun::embed_file("table2.xlsx")
xfun::embed_file("table3.xlsx")
xfun::embed_file("table4.xlsx")
xfun::embed_file("table5.xlsx")
xfun::embed_file("table6.xlsx")
table1.table <- xtable::xtable(table1)
print(table1.table, tabular.environment="longtable", floating=FALSE, include.rownames=FALSE, add.to.row = addtorow, hline.after=c(-1), file="table_latex_1.txt")
table2.table <- xtable::xtable(table2)
print(table2.table, tabular.environment="longtable", floating=FALSE, include.rownames=FALSE, add.to.row = addtorow, hline.after=c(-1), file="table_latex_2.txt")
table3.table <- xtable::xtable(table3)
print(table3.table, tabular.environment="longtable", floating=FALSE, include.rownames=FALSE, add.to.row = addtorow, hline.after=c(-1), file="table_latex_3.txt")
table4.table <- xtable::xtable(table4)
print(table4.table, tabular.environment="longtable", floating=FALSE, include.rownames=FALSE, add.to.row = addtorow, hline.after=c(-1), file="table_latex_4.txt")
table5.table <- xtable::xtable(table5)
print(table5.table, tabular.environment="longtable", floating=FALSE, include.rownames=FALSE, add.to.row = addtorow, hline.after=c(-1), file="table_latex_5.txt")
table6.table <- xtable::xtable(table6)
print(table6.table, tabular.environment="longtable", floating=FALSE, include.rownames=FALSE, add.to.row = addtorow, hline.after=c(-1), file="table_latex_6.txt")
#Calculate share of NAs per country
clean_data_na<-data%>%
group_by(country)%>%
summarise_all(list(na = ~mean(is.na(.))))
clean_data_na<-clean_data_na%>% mutate(na_over = rowMeans(.[, 10:99]))
clean_data_na<-clean_data_na%>%select("country", "na_over")
clean_data<-merge(data,clean_data_na,by="country")
clean_data$na_over<-100*clean_data$na_over
# defining shape map
world_map<-map_data("world")
# world_map ordering and removing Antarctica
world_map<-world_map[order(world_map$group,world_map$order),] %>% filter(region != "Antarctica")
clean_data$country2<-if_else(clean_data$country %in% "US",
"USA",
if_else(clean_data$country=="RU",
"Russia",
if_else(clean_data$country=="KR",
"South Korea",
if_else(clean_data$country=="GB", "UK", as.character(sjlabelled::as_label(clean_data$ISO3))))))
# standadizing country names to match across dt
sample_size_n <- clean_data %>% group_by(country2) %>% tally()
sample_size_n$country2 <- if_else(sample_size_n$country2=="United States of America",
"USA",
if_else(sample_size_n$country2=="Russian Federation",
"Russia",
if_else(sample_size_n$country2=="Korea",
"South Korea",
if_else(sample_size_n$country2=="United Kingdom", "UK", as.character(sample_size_n$country2)))))
library(wesanderson)
library(rworldmap)
library(ggthemes)
library(extrafont)
library(ggplot2)
palette_wa <- wes_palette("Zissou1", 5, type = "continuous")
ggplot(sample_size_n) +
geom_polygon(data = world_map, aes(x = long, y = lat, group = group),
color="#ffffff00",size=0.05, fill = "gray90") +
geom_map(aes(map_id = country2, fill = n), map = world_map,
color="#ffffff", size=0.05) +
expand_limits(x = world_map$long, y = world_map$lat) +
coord_fixed() +
scale_x_discrete(labels = NULL, breaks = NULL) +
scale_y_discrete(labels = NULL, breaks = NULL) +
scale_fill_gradientn(colours = palette_wa,
limits = c(0, 2500),
breaks = c(0, 500, 1000, 1500, 2000, 2500),
labels = c(0, 500, 1000, 1500, 2000, 2500),
name = "Sample\nsize",
guide = guide_colorbar(
direction = "vertical",
barheight = unit(20, units = "mm"),
barwidth = unit(3, units = "mm"),
draw.ulim = F,
title.position = 'top',
# some shifting around
title.hjust = 0,
label.hjust = 0)) +
labs(x=NULL, y=NULL) +
theme_map() +
theme(text = element_text(family = "Georgia"),
legend.position = c(0.05, 0.01), legend.text.align = 0,
legend.background = element_rect(fill = 'white'),
legend.text = element_text(size = 6, hjust = 0,
color = "#4e4d47"),
plot.tag.position = c(0.1, 0),
plot.tag = element_text(size = 10, hjust = 0.1, vjust = 2),
plot.title = element_text(color = "#4e4d47",
size=12, face = "bold",
vjust = 3),
plot.subtitle = element_text(color = "#4e4d47", vjust = 2,
margin = margin(b = -0.00001,
t = 0.05,
l = 2,
unit = "cm"), debug = F),
legend.title = element_text(size = 7),
plot.margin = unit(c(.1,.1,.1,.1), "cm"),
panel.spacing = unit(c(-.1,0.2,.2,0.2), "cm"),
panel.border = element_blank(),
plot.caption = element_text(size=8,
family="Georgia",color="gray35")) +
labs(title="Sample sizes across 69 countries",
subtitle="Heat map showing the number of respondents from each country",
caption = "International Collaboration on the Social & Moral Psychology of COVID-19\nhttps://icsmp-covid19.netlify.app"
#tag = expression(paste(bold("Fig 1. "), "A world map visualizing the number of participants in each surveyed country."))
) +
theme(
plot.title = element_text(size = 12, family="Georgia", face = "plain", color="black"),
plot.caption = element_text(color = "#383838", face = "italic", size = 7))
Figure 1. A world map visualizing the number of participants in each surveyed country.
Figure 2. Gantt Chart illustrating the data collection periods for each surveyed country.
knitr::include_graphics("1.jpg")
Figure 3.a. International Collaboration on the Social and Moral Psychology of COVID-19: Investigated constructs, items, and variable
knitr::include_graphics("2.jpg")
Figure 3.b. International Collaboration on the Social and Moral Psychology of COVID-19: Investigated constructs, items, and variable
palette_wa <- wes_palette("Zissou1",
5,
type = "continuous")
Zissou1_NAs2 <-
ggplot(clean_data) +
geom_polygon(data = world_map, aes(x = long, y = lat, group = group),
color="#ffffff00",size=0.05, fill = "gray90") +
geom_map(aes(map_id = country2, fill = na_over), map = world_map,
color="#ffffff", size=0.05) +
expand_limits(x = world_map$long, y = world_map$lat) +
coord_fixed()+
scale_x_discrete(labels = NULL, breaks = NULL) +
scale_y_discrete(labels = NULL, breaks = NULL) +
scale_fill_gradientn(colours = palette_wa,
limits = c(0, 50),
breaks = c(0, 10, 20, 30, 40, 50),
labels = c("0%", "10%", "20%", "30%", "40%", "50%"),
name = "Missing\ndata",
guide = guide_colorbar(
direction = "vertical",
barheight = unit(20, units = "mm"),
barwidth = unit(3, units = "mm"),
draw.ulim = F,
title.position = 'top',
# some shifting around
title.hjust = 0,
label.hjust = 0)) +
labs(x=NULL, y=NULL,
title="Overall percentages of missing data by country", caption = "\n\n") +
theme_map() +
theme(text = element_text(family = "Georgia"),
legend.position = c(0.05, 0.01),legend.text.align = 0,
legend.background = element_rect(fill = 'white'),
legend.text = element_text(size = 6, hjust = 0,
color = "#4e4d47"),
plot.tag.position = c(0.1, 0),
plot.tag = element_text(size = 10, hjust = 0.1, vjust = 2),
plot.title = element_text(size = 12, family="Georgia",
face = "plain", color="black"),
plot.subtitle = element_text(color = "#4e4d47", vjust = 2,
margin = margin(b = -0.00001, t = 0.05,
l = 2, unit = "cm"), debug = F),
legend.title = element_text(size = 7),
plot.margin = unit(c(.1,.1,.1,.1), "cm"),
panel.spacing = unit(c(-.1,0.2,.2,0.2), "cm"),
panel.border = element_blank(),
plot.caption = element_text(size=8, family="Georgia",color="gray35"))
# setting up plot 2
att_check_fail<-as.data.frame(clean_data %>% select(country2, att_check_nobots))
att_check_fail<-filter(att_check_fail, !is.na(att_check_nobots))
att_check_fail <- as.data.frame(aggregate(att_check_fail[, 2], list(att_check_fail$country2), mean))
names(att_check_fail) <- c("country", "fail")
att_check_fail$fail<-1-att_check_fail$fail
# ploting
Zissou1_check2 <-
ggplot(att_check_fail) +
geom_polygon(data = world_map, aes(x = long, y = lat, group = group),
color="#ffffff00",size=0.05, fill = "gray90") +
geom_map(aes(map_id = country, fill = fail*100), map = world_map,
color="#ffffff", size=0.05) +
expand_limits(x = world_map$long, y = world_map$lat) +
coord_fixed()+
scale_x_discrete(labels = NULL, breaks = NULL) +
scale_y_discrete(labels = NULL, breaks = NULL) +
scale_fill_gradientn(colours = palette_wa,
limits = c(0, 20),
breaks = c(0, 5, 10, 15, 20),
labels = c("0%", "5%", "10%", "15%", "20%"),
name = "Attention\nCheck Fails\n",
guide = guide_colorbar(
direction = "vertical",
barheight = unit(20, units = "mm"),
barwidth = unit(3, units = "mm"),
draw.ulim = F,
title.position = 'top',
# some shifting around
title.hjust = 0,
label.hjust = 0)) +
labs(x=NULL, y=NULL, title="Rate of attention-check fails across 69 countries") +
#caption = "International Collaboration on the Social & Moral Psychology of COVID-19\nhttps://icsmp-covid19.netlify.app")+
theme_map() +
theme(text = element_text(family = "Georgia"),
legend.position = c(0.05, 0.01),legend.text.align = 0,
legend.background = element_rect(fill = 'white'),
legend.text = element_text(size = 6, hjust = 0,
color = "#4e4d47"),
plot.tag.position = c(0.1, 0),
plot.tag = element_text(size = 10, hjust = 0.1, vjust = 2),
plot.title = element_text(size = 12, family="Georgia",
face = "plain", color="black"),
plot.subtitle = element_text(color = "#4e4d47", vjust = 2,
margin = margin(b = -0.00001,
t = 0.05,
l = 2,
unit = "cm"), debug = F),
legend.title = element_text(size = 7),
plot.margin = unit(c(.1,.1,.1,.1), "cm"),
panel.spacing = unit(c(-.1,0.2,.2,0.2), "cm"),
panel.border = element_blank(),
plot.caption = element_text(size=8,
family="Georgia",color="gray35"))
# setting up multiple plots
library(patchwork)
com_plots <- (Zissou1_NAs2/Zissou1_check2) +
plot_annotation(caption = "\nInternational Collaboration on the Social & Moral Psychology of COVID-19\nhttps://icsmp-covid19.netlify.app") &
theme(plot.caption = element_text(color = "#383838", face = "italic", size = 7, family="Georgia"))
#
com_plots
Figure 4. Data quality indicators for each surveyed country.
#
#ggpubr::ggarrange(Zissou1_NAs2, Zissou1_check2,ncol = 1, nrow = 2)
#
#cowplot::plot_grid(Zissou1_NAs2, Zissou1_check2, labels = c('A', 'B'), ncol = 1)
##### arranging info for constructs: pcontact; hygiene; psupport
fig_5_contact<-as.data.frame(clean_data %>% select(ISO3, contact1, contact2,contact3,contact4,contact5))
fig_5_contact<-reshape2::melt(fig_5_contact, id="ISO3")
fig_5_contact<-filter(fig_5_contact, !is.na(fig_5_contact$value))
fig_5_contact$value<-if_else(fig_5_contact$value=="Strongly Agree",10,
if_else(fig_5_contact$value=="Strongly Disagree", 0,
if_else(fig_5_contact$value=="Neither agree nor disagree",5,
as.numeric(fig_5_contact$value))))
contact<-as.data.frame(aggregate(fig_5_contact[, 3], list(fig_5_contact$ISO3), mean))
#
#
fig_5_support<-as.data.frame(clean_data %>% select(ISO3, psupport1, psupport2,psupport3,psupport4,psupport5))
fig_5_support<-reshape2::melt(fig_5_support, id="ISO3")
fig_5_support<-filter(fig_5_support, !is.na(fig_5_support$value))
fig_5_support$value<-if_else(fig_5_support$value=="Strongly Agree",10,
if_else(fig_5_support$value=="Strongly Disagree", 0,
if_else(fig_5_support$value=="Neither agree nor disagree",5,
as.numeric(fig_5_support$value))))
support<-as.data.frame(aggregate(fig_5_support[, 3], list(fig_5_support$ISO3), mean))
fig_5_hygiene<-as.data.frame(clean_data %>% select(ISO3, hygiene1, hygiene2,hygiene3,hygiene4,hygiene5))
fig_5_hygiene<-reshape2::melt(fig_5_hygiene, id="ISO3")
fig_5_hygiene<-filter(fig_5_hygiene,!is.na(fig_5_hygiene$value))
fig_5_hygiene$value<-if_else(fig_5_hygiene$value=="Strongly Agree",10,
if_else(fig_5_hygiene$value=="Strongly Disagree", 0,
if_else(fig_5_hygiene$value=="Neither agree nor disagree",5,
as.numeric(fig_5_hygiene$value))))
hygiene<-as.data.frame(aggregate(fig_5_hygiene[, 3], list(fig_5_hygiene$ISO3), mean))
hygiene$country<-hygiene$Group.1
contact$country<-contact$Group.1
support$country<-support$Group.1
##### arranging data conspiracy
fig_5_cons<-as.data.frame(clean_data %>% select(ISO3, ctheory1, ctheory2, ctheory3, ctheory4))
fig_5_cons<-reshape2::melt(fig_5_cons, id="ISO3")
fig_5_cons<-filter(fig_5_cons,!is.na(fig_5_cons$value))
fig_5_cons$value<-if_else(fig_5_cons$value=="Strongly Agree",10,
if_else(fig_5_cons$value=="Strongly Disagree", 0,
if_else(fig_5_cons$value=="Neither agree nor disagree",5,
as.numeric(fig_5_cons$value))))
cons<-as.data.frame(aggregate(fig_5_cons[, 3], list(fig_5_cons$ISO3), mean))
cons$country<-cons$Group.1
##### arranging data national identity #####
fig_5_national_ident<-as.data.frame(clean_data %>% select(ISO3, nidentity1, nidentity2))
fig_5_national_ident<-reshape2::melt(fig_5_national_ident, id="ISO3")
fig_5_national_ident<-filter(fig_5_national_ident,!is.na(fig_5_national_ident$value))
fig_5_national_ident$value<-if_else(fig_5_national_ident$value=="Strongly Agree",10,
if_else(fig_5_national_ident$value=="Strongly Disagree", 0,
if_else(fig_5_national_ident$value=="Neither agree nor disagree",5,
as.numeric(fig_5_national_ident$value))))
national_ident<-as.data.frame(aggregate(fig_5_national_ident[, 3], list(fig_5_national_ident$ISO3), mean))
national_ident$country<-national_ident$Group.1
##### arranging data national narcissism #####
fig_5_national_narc<-as.data.frame(clean_data %>% select(ISO3, cnarc1, cnarc2, cnarc3))
fig_5_national_narc<-reshape2::melt(fig_5_national_narc, id="ISO3")
fig_5_national_narc<-filter(fig_5_national_narc, !is.na(fig_5_national_narc$value))
fig_5_national_narc$value<-if_else(fig_5_national_narc$value=="Strongly Agree",10,
if_else(fig_5_national_narc$value=="Strongly Disagree", 0,
if_else(fig_5_national_narc$value=="Neither agree nor disagree",5,
as.numeric(fig_5_national_narc$value))))
national_narc<-as.data.frame(aggregate(fig_5_national_narc[, 3], list(fig_5_national_narc$ISO3), mean))
national_narc$country<-national_narc$Group.1
##### arranging data social belonging #####
fig_5_soc_belong<-as.data.frame(clean_data %>% select(ISO3, sbelong1, sbelong2, sbelong3,sbelong4))
fig_5_soc_belong<-reshape2::melt(fig_5_soc_belong, id="ISO3")
fig_5_soc_belong<-filter(fig_5_soc_belong,!is.na(fig_5_soc_belong$value))
fig_5_soc_belong$value<-if_else(fig_5_soc_belong$value=="Strongly Agree",10,
if_else(fig_5_soc_belong$value=="Strongly Disagree", 0,
if_else(fig_5_soc_belong$value=="Neither agree nor disagree",5,
as.numeric(fig_5_soc_belong$value))))
soc_belong<-as.data.frame(aggregate(fig_5_soc_belong[, 3], list(fig_5_soc_belong$ISO3), mean))
soc_belong$country<-soc_belong$Group.1
#This construct is different than the others, it is measured by percentage.
##### arranging data risk perception #####
fig_5_risk_perc<-as.data.frame(clean_data %>% select(ISO3, riskperc1, riskperc2))
fig_5_risk_perc<-reshape2::melt(fig_5_risk_perc, id="ISO3")
fig_5_risk_perc<-filter(fig_5_risk_perc,!is.na(fig_5_risk_perc$value))
risk_perc<-as.data.frame(aggregate(fig_5_risk_perc[, 3], list(fig_5_risk_perc$ISO3), mean))
risk_perc$country<-risk_perc$Group.1
## Political ideology construct
### arranging data political ideology
pol_ide <- clean_data %>%
select(ISO3, political_ideology) %>%
filter(., !is.na(political_ideology)) %>%
group_by(ISO3) %>%
summarise_all(funs(mean(., na.rm=TRUE))) %>%
ungroup() %>%
as.data.frame() %>% dplyr::rename(x=political_ideology)
pol_ide$Group.1 <- countrycode::countrycode(pol_ide$ISO3, "iso3c", "country.name")
pol_ide$country <- pol_ide$Group.1
#
##### arranging data COOPERATION #####
fig_5_coop<-as.data.frame(clean_data %>% select(ISO3, mcoop1, mcoop2, mcoop3,mcoop4, mcoop5,mcoop6,mcoop7))
fig_5_coop<-reshape2::melt(fig_5_coop, id="ISO3")
fig_5_coop<-filter(fig_5_coop, !is.na(fig_5_coop$value))
fig_5_coop$value<-if_else(fig_5_coop$value=="Strongly Agree",10,
if_else(fig_5_coop$value=="Strongly Disagree", 0,
if_else(fig_5_coop$value=="Neither agree nor disagree",5,
as.numeric(fig_5_coop$value))))
coop<-as.data.frame(aggregate(fig_5_coop[, 3], list(fig_5_coop$ISO3), mean))
coop$country<-coop$Group.1
#library(tidyverse)
require(dplyr)
risk_perc$risk_perception<-risk_perc$x
cons$conspiracy<-cons$x
national_ident$national_identity<-national_ident$x
national_narc$narcissism<-national_narc$x
soc_belong$social_belonging<-soc_belong$x
coop$cooperation<-coop$x
support$policy_support<-support$x
contact$distancing<-contact$x
hygiene$personal_hygiene<-hygiene$x
constructs <- risk_perc %>%
left_join(hygiene, by = "country") %>%
left_join(support, by = "country") %>%
left_join(contact, by = "country") %>%
left_join(cons, by = "country") %>%
left_join(national_ident, by = "country") %>%
left_join(national_narc, by = "country") %>%
left_join(soc_belong, by = "country") %>%
left_join(coop, by = "country") %>% select(country,
risk_perception,
personal_hygiene,
distancing,
policy_support,
conspiracy,
national_identity,
narcissism,
social_belonging,
cooperation)
constructs <- constructs %>% gather(., key = "variable", value = "value", -country)
facet_const_WA_fun <- function(construct_db,
var = "variable",
vect_contruct,
facet_name,
name_palette = "palette",
n_colors,
numcol = 3,
numrow = 1,
label_name,
Lim,
bre,
legend_name = "Legend\nName\nNULL*") {
require(wesanderson)
contruct <- construct_db[construct_db[[var]] %in% vect_contruct, ]
palette_wa <- wes_palette(name_palette, n_colors,
type = "continuous")
ggplot(subset(contruct, country2!=0)) +
geom_polygon(data = world_map, aes(x = long, y = lat, group = group),
color="#ffffff00",size=0.05, fill = "gray90") +
geom_map(aes(map_id = country2, fill = value, group=1),
map = world_map, color="#ffffff", size=0.05) +
expand_limits(x = world_map$long, y = world_map$lat)+
coord_fixed()+
labs(x=NULL, y=NULL)+
facet_wrap(.~variable, nrow = numrow, ncol = numcol,
labeller = as_labeller(facet_name))+
scale_x_discrete(expand = c(0, 0.5)) +
scale_fill_gradientn(colors= palette_wa, na.value='#f5f5f2',
labels = label_name,
limits = Lim,
breaks = bre, ) +
#breaks = c(min(contructs_other$value), 3, 5, 7,
# max(contructs_other$value)),
#labels = c((round(min(contructs_other$value))),
# 3, 5, 7, round(max(contructs_other$value))))+
theme_mapX()+
guides(fill = guide_colourbar(direction = 'vertical',
title=legend_name, ##rename default legend
title.position='top',
title.hjust=0.5,
ticks.colour='#f5f5f2',
ticks.linewidth=2,
barwidth = 0.3,
barheight = 5))
}
###### functions test colors an ranging palette FOR FACET_WRAP MAPS#####
##### Function THEME_MAPX #####
theme_mapX <- function(...) {
theme_minimal() +
theme(panel.spacing.x = unit(0, "cm"),
panel.spacing.y = unit(0, "cm"),
axis.line = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(size = 10, face = "bold", vjust = 2,
hjust=0.1,family="Georgia",color="gray35"),
plot.subtitle = element_text(size = 10,hjust=0.1,
family="Georgia"),
plot.caption = element_text(size=8,
family="Georgia",color="gray35"),
strip.text.x = element_text(size=7,hjust=0,vjust=0,family="Georgia"),
#plot.background = element_rect(fill = "#f5f5f2", color = NA),
plot.margin = unit(c(.1,.1,.1,.1), "cm"),
#panel.background = element_rect(fill = "#f5f5f2", color =NA),
panel.border = element_blank(),
legend.position = 'right',
#legend.background = element_rect(fill = "#f5f5f2", color = NA),
legend.title = element_text(size = 8,family="Georgia"),
legend.text = element_text(size = 7, family="Georgia"),
legend.key = element_rect(),
plot.tag.position = c(0.1, 0),
plot.tag = element_text(size = 10, hjust = 0.1, vjust = 2),
)}
vect_constructs_1 <- c("distancing", "policy_support",
"conspiracy", "national_identity",
"narcissism", "cooperation")
facet_names_1 <- c(`distancing` = "Spatial Distancing",
`policy_support` = "Policy Support for Preventive Measures",
`conspiracy` = "Conspiracy Beliefs",
`national_identity` = "National identification",
`narcissism` = "National Narcissism",
`cooperation` = "Morality as Cooperation")
constructs$country2 <- sjlabelled::as_label(constructs$country)
constructs$country2 <- if_else(constructs$country2=="United States of America",
"USA",
if_else(constructs$country2=="Russian Federation",
"Russia",
if_else(constructs$country2=="Korea",
"South Korea",
if_else(constructs$country2=="United Kingdom", "UK", as.character(constructs$country2)))))
Zissou1_ALL_grid_2 <- facet_const_WA_fun(constructs,
var = "variable",
vect_constructs_1,
facet_names_1,
name_palette = "Zissou1",
n_colors = 4,
numcol = 2,
numrow = 3,
Lim = c(0, 10),
bre = c(0, 10),
label_name = c("Lower\nlevels", "Higher\nlevels"),
legend_name = "") +
labs(title="Cross-cultural differences in Social & Moral Psychology of COVID-19",
#subtitle="across 69 countries",
#caption="International Collaboration on the Social & Moral Psychology of COVID-19\nhttps://icsmp-covid19.netlify.app/\nScale = Strongly Agree or higher level (10), Neither agree nor disagree (5), Strongly Disagree or lower level (0)"
caption = "International Collaboration on the Social & Moral Psychology of COVID-19\nhttps://icsmp-covid19.netlify.app"
) +
theme(plot.title = element_text(size = 13, family="Georgia", face = "plain", color="black"),
#axis.text.x.left = element_blank(),
legend.position = c(0.535, 0.475),
legend.text=element_text(size=8),
strip.text.x = element_text(size = 11, color="black" , family="Georgia", hjust=0.5),
plot.caption = element_text(color = "#383838", face = "italic", size = 7, family="Georgia"))
Zissou1_ALL_grid_2
Figure 5. Cross-cultural differences in Social & Moral Psychology of COVID-19 across 69 countries.
# classification of the demographics of interest ####
data$age_cat = ifelse(data$age %in% 18:24, "18 to 24 years old",
ifelse(data$age %in% 25:34, "25 to 34 years old",
ifelse(data$age %in% 35:44, "35 to 44 years old",
ifelse(data$age %in% 45:54, "45 to 54 years old",
ifelse(data$age %in% 55:64, "55 to 64 years old",
ifelse(data$age %in% 65:100,"65 years old and up",NA))))))
data$sex_cat = ifelse(data$sex1 == 1, "Male",
ifelse(data$sex1 == 2, "Female",NA))
data$pol_cat = ifelse(data$political_ideology %in% 0:4, "1. Left",
ifelse(data$political_ideology %in% 5, "2. Center",
ifelse(data$political_ideology %in% 6:10, "3. Right", NA)))
# data selection ####
## attention check
data_cleaned = data[data$att_check_nobots==1 & !is.na(data$att_check_nobots),]
## minimum n
# This paper (https://www.sciencedirect.com/science/article/abs/pii/S0092656619300297) suggests maintaining n=490 as a minimum for correlation analysis. Even though the following analyses are not conducted per country, this minimum is enforced nevertheless. Enforcement of a minimum n is also necessary for the calculation of the consistency statistics.
"%!in%" = Negate("%in%")
min_n = 490
ISO3_n = as.data.frame(table(data_cleaned$ISO3))
small_n_ISO = as.vector(ISO3_n$Var1[ISO3_n$Freq<min_n])
data_cleaned = data_cleaned[data_cleaned$ISO3 %!in% small_n_ISO,]
# define index selections ####
indices = c("ctheory_index","mcoop_index","contact_index","cnarc_index","nidentity_index","psupport_index","hygiene_index","moralid_index","narc_index","omind_index","optim_index","riskperc_index","sbelong_index","slfcont_index")
labels = c("conspiracy beliefs (1)", "morality as cooperation (2)", "spatial distancing (3)", "national narcissism (4)", "national identification (5)", "policy support (6)", "physical hygiene (7)", "moral identity (8)", "narcissism (9)", "open mindedness (10)", "optimism (11)", "risk perception (12)", "social belonging (13)", "self-control (14)")
dem_cat = c("age_cat","sex_cat","pol_cat")
# calculate correlations between indices ####
index_data = data_cleaned[,names(data_cleaned) %in% c(indices)]
correlations = cor(index_data, use = "complete.obs")
# summary stats correlations ####
levels <- colnames(correlations)
corr_summary = correlations %>%
data.frame() %>%
mutate(row = factor(rownames(.), levels = levels)) %>%
pivot_longer(-c(row), names_to = "col") %>%
mutate(col = factor(col, levels = levels))
corr_summary = corr_summary[duplicated(corr_summary$value),]
corr_summary = corr_summary[corr_summary$value!=1 ,]
# Descriptive Statistics
min(abs(corr_summary$value))
## [1] 0.003114215
max(abs(corr_summary$value))
## [1] 0.484048
mean(abs(corr_summary$value))
## [1] 0.1684443
# plots ####
# With great help from Stefan and others at StackOverflow (https://stackoverflow.com/questions/71890644/how-to-replicate-correlation-plot-with-greyscale-coefficients-in-the-lower-half), I managed to create these beautiful correlation plots.
fullcorr = data.frame(matrix(ncol = 7, nrow = 0))
colnames(fullcorr) = c("row","rowid","col","value","colid","dem","demval")
for(i in 1:length(dem_cat)){
dem = dem_cat[i]
unique_vals = unique(data_cleaned[,names(data_cleaned) %in% dem_cat[i]])
unique_vals = unique_vals[!is.na(unique_vals)]
for(j in 1:length(unique_vals)){
data_selection = data_cleaned[data_cleaned[,dem] == unique_vals[j] &
!is.na(data_cleaned[,dem] == unique_vals[j]),
names(data_cleaned) %in% indices]
correlations = as.data.frame(cor(data_selection, use="complete.obs"))
levels <- colnames(correlations)
corr_long <- correlations %>%
data.frame() %>%
mutate(row = factor(rownames(.), levels = levels),
rowid = as.numeric(row)) %>%
pivot_longer(-c(row, rowid), names_to = "col") %>%
mutate(col = factor(col, levels = levels),
colid = as.numeric(col))
corr_long$dem = dem
corr_long$demval = unique_vals[j]
fullcorr = rbind(fullcorr, corr_long)
}
}
# age plot ####
age_data = fullcorr[fullcorr$dem == "age_cat",]
corrplot_age_facets =
ggplot(age_data, aes(col, row)) +
geom_point(aes(size = abs(value),
fill = value, stroke = 0.1,
alpha= abs(value)),
data = ~filter(.x, rowid > colid), shape = 21) +
geom_text(aes(label = scales::number(value, accuracy = .01),
color = abs(value),
family = "Georgia"),
data = ~filter(.x, rowid < colid), size = 8 / .pt) +
scale_x_discrete(labels = 1:14, drop = FALSE) +
scale_y_discrete(labels = rev(labels), drop = FALSE, limits=rev) +
scale_fill_viridis_c(limits = c(-.6, .6)) +
scale_color_gradient(low = grey(.985), high = grey(.015)) +
coord_equal() +
guides(size = "none", color = "none", alpha = "none") +
theme_minimal() +
theme(text = element_text(family = "Georgia"),
legend.position = "none",
panel.grid = element_blank(),
plot.margin=unit(c(-2,1,1,1), "cm"),
strip.background=element_rect(colour="white", fill="#f6f6f6"),
axis.ticks = element_blank()) +
labs(title = "Construct associations by age",
x = NULL, y = NULL, fill = NULL) +
facet_wrap(~demval, nrow=2)
# png(file = "./Plots/corrplot_age_facets.png",
# width = 1500, # The width of the plot
# height = 1000) # The height of the plot
# corrplot_age_facets
# dev.off()
# sex plot ####
sex_data = fullcorr[fullcorr$dem == "sex_cat",]
corrplot_sex_facets =
ggplot(sex_data, aes(col, row)) +
geom_point(aes(size = abs(value),
fill = value, stroke = 0.1,
alpha= abs(value)),
data = ~filter(.x, rowid > colid), shape = 21) +
geom_text(aes(label = scales::number(value, accuracy = .01),
color = abs(value),
family = "Georgia"),
data = ~filter(.x, rowid < colid), size = 8 / .pt) +
scale_x_discrete(labels = 1:14, drop = FALSE) +
scale_y_discrete(labels = rev(labels), drop = FALSE, limits=rev) +
scale_fill_viridis_c(limits = c(-.65, .65), name="Person's\nCorrelation\nCoefficient") +
scale_color_gradient(low = grey(.985), high = grey(.015)) +
coord_equal() +
guides(size = "none", color = "none", alpha = "none") +
theme_minimal() +
theme(text = element_text(family = "Georgia"),
#legend.position = "none",
plot.margin=unit(c(1,4,-2,4), "cm"),
panel.grid = element_blank(),
legend.position=c(1.2,0.5),
legend.text=element_text(size=8),
legend.title=element_text(size=8),
strip.background=element_rect(colour="white", fill="#f6f6f6"),
axis.ticks = element_blank()) +
labs(title = "Construct associations by sex",
x = NULL, y = NULL, fill = NULL) +
facet_wrap(~demval, nrow=1)
# png(file = "./Plots/corrplot_sex_facets.png",
# width = 1000, # The width of the plot
# height = 500) # The height of the plot
# corrplot_sex_facets
# dev.off()
# pol plot ####
pol_data = fullcorr[fullcorr$dem == "pol_cat",]
corrplot_pol_facets =
ggplot(pol_data, aes(col, row)) +
geom_point(aes(size = abs(value),
fill = value, stroke = 0.1,
alpha= abs(value)),
data = ~filter(.x, rowid > colid), shape = 21) +
geom_text(aes(label = scales::number(value, accuracy = .01),
color = abs(value),
family = "Georgia"),
data = ~filter(.x, rowid < colid), size = 8 / .pt) +
scale_x_discrete(labels = 1:14, drop = FALSE) +
scale_y_discrete(labels = rev(labels), drop = FALSE, limits=rev) +
scale_fill_viridis_c(limits = c(-.6, .6)) +
scale_color_gradient(low = grey(.985), high = grey(.015)) +
coord_equal() +
guides(size = "none", color = "none", alpha = "none") +
theme_minimal() +
theme(text = element_text(family = "Georgia"),
legend.position = "none",
plot.margin=unit(c(-2,1,-2,1), "cm"),
panel.grid = element_blank(),
strip.background=element_rect(colour="white", fill="#f6f6f6"),
axis.ticks = element_blank()) +
labs(title = "Construct associations by ideology",
x = NULL, y = NULL, fill = NULL, alpha = NULL) +
facet_wrap(~demval, ncol=3)
# png(file = "./Plots/corrplot_pol_facets.png",
# width = 1500, # The width of the plot
# height = 500) # The height of the plot
# corrplot_pol_facets
# dev.off()
#corrplot_sex_facets
#corrplot_age_facets
#corrplot_pol_facets
# com_plots2 <- (corrplot_sex_facets/corrplot_pol_facets)
#
# #com_plots2 / corrplot_age_facets + plot_layout(heights = unit(c(12, 6, 6), c('cm', 'null')))
#
# wrap_plots(com_plots2, corrplot_age_facets, nrow=2) +
# plot_annotation(caption = "\nInternational Collaboration on the Social & Moral Psychology of COVID-19\nhttps://icsmp-covid19.netlify.app") &
# theme(plot.caption = element_text(color = "#383838", face = "italic", size = 7, family="Georgia"))
library(gridExtra)
grid.arrange(corrplot_sex_facets,
corrplot_pol_facets,
corrplot_age_facets,
ncol = 1,
heights = c(1, 1.4, 2))
Figure 6. Cross-cultural differences in associations of Social & Moral Psychology of COVID-19 across Sociodemographics in 69 countries.
# notes: first create the full dataframe with empty values, then cycle through to fill in. The omega consistency value cannot be calculated for constructs that rely on only two items, in this case national identity. Note that average split half reliability (meanr) yielded values that exceeded 1. Therefore opted to proceed with Maximum split half reliability (lambda 4) (maxrb). Also note that omega gives warnings that may need to be considered.
library(countrycode)
palette = wes_palette("Zissou1", 100, type = "continuous")
# index vectors
measures = c("alpha","omega","guttman","variance")
indices6 = c("ctheory","mcoop","contact","cnarc","nidentity","psupport")
index_labels = c("Conspiracy beliefs","Morality as cooperation","Spatial distancing","Collective narcissism","National identity","Policy support")
# create world data
world_map<-map_data("world")
world_map<-world_map[order(world_map$group,world_map$order),] %>% filter(region != "Antarctica")
theme_map <- function(...) {
theme_minimal() +
theme(panel.spacing.x = unit(0, "cm"),
panel.spacing.y = unit(0, "cm"),
axis.line = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(size = 10,
face = "bold",
vjust = 2,
hjust=0,
family="Georgia",
color="gray35"),
plot.subtitle = element_text(size = 10,
hjust=0,
family="Georgia"),
plot.caption = element_text(size=8,
family="Georgia",
color="gray35"),
strip.text.x = element_text(size=7,
hjust=0,
vjust=0,
family="Georgia"),
#plot.background = element_rect(fill = "#f5f5f2", color = NA),
plot.margin = unit(c(.1,.1,.1,.1), "cm"),
#panel.background = element_rect(fill = "#f5f5f2", color =NA),
panel.border = element_blank(),
legend.position = 'right',
#legend.background = element_rect(fill = "#f5f5f2", color = NA),
legend.title = element_text(size = 6,family="Georgia"),
legend.text = element_text(size = 5, family="Georgia"),
legend.key = element_rect(),
plot.tag.position = c(0.1, 0),
plot.tag = element_text(size = 10, hjust = 0.1, vjust = 2))
}
# define mapping function
mapping_f = function(name_palette = "palette",
n_colors,
legeng_name = "Legend\nName\nNULL*"){
ggplot(data_selection) +
# data input
geom_polygon(data = world_map,
aes(x = long, y = lat, group = group),
color="#ffffff00", size=0.05, fill = "gray90") +
geom_map(aes(map_id = ISO3, fill = value),
map = world_map,
color="#ffffff", size=0.05) +
facet_wrap(~measure) +
# some other settings
expand_limits(x = world_map$long, y = world_map$lat) +
coord_fixed() +
# axes settings
scale_x_discrete(labels = NULL, breaks = NULL) +
scale_y_discrete(labels = NULL, breaks = NULL) +
scale_fill_gradientn("Coefficient\nValue",
colours = palette,
limits = c(.2, 1),
breaks = seq(.2,1,0.1),
labels = seq(.2,1,0.1),
#name = legeng_name,
guide = guide_colorbar(
direction = "vertical",
barheight = unit(15, units = "mm"),
barwidth = unit(3, units = "mm"),
draw.ulim = F,
title.position = 'top',
# some shifting around
title.hjust = 0,
label.hjust = 0)) +
labs(x=NULL, y=NULL) +
# theme settings
theme_map() +
theme(text = element_text(family = "Georgia"),
legend.position = c(0.05, 0.1),
legend.text.align = 0,
legend.background = element_rect(color = NA), # changed from original code
legend.text = element_text(size = 4,
hjust = 0,
color = "#4e4d47"),
plot.tag.position = c(0.1, 0),
plot.tag = element_text(size = 9, hjust = 0.1, vjust = 2),
plot.title = element_text(color = "#4e4d47",
size=12, face = "bold",
vjust = 3,
hjust = 0), # changed from original code
plot.subtitle = element_text(color = "#4e4d47",
vjust = 2,
hjust = 0,
margin = margin(b = -0.00001,
t = 0.05,
l = 2,
unit = "cm"), debug = F),
legend.title = element_text(size = 6),
plot.margin = unit(c(.1,.1,.1,.1), "cm"),
panel.spacing = unit(c(-.1,0.2,.2,0.2), "cm"),
panel.border = element_blank(),
plot.caption = element_text(size=8,
family="Georgia",color="gray35"))
}
# loop though constructs and make map for each
for(i in 1:length(indices6)){
# select data per construct
data_selection = table6[,names(table6) %in% c("Country","measure_label", index_labels[i])] # select necessary data
names(data_selection) = c("ISO3","measure","value") # give uniform names
data_selection$ISO3 = ifelse(data_selection$ISO3=="United States of America", "USA",
ifelse(data_selection$ISO3=="United Kingdom", "UK",
ifelse(data_selection$ISO3=="Russian Federation", "Russia",
ifelse(data_selection$ISO3=="Korea", "South Korea",
data_selection$ISO3)))) # adjust a few country names
# plot
# png(file = paste0("./Plots/map_consistency_",indices6[i],".png"),
# width = 800, # The width of the plot
# height = 1000) # The height of the plot
plot(assign(paste("map",indices6[i], sep = "_"),
mapping_f(name_palette = "Zissou1",
n_colors = 5,
legeng_name = "Sample\nsize") +
labs(title=index_labels[i],
subtitle="Heat map showing consistency measures for each country",
caption = "International Collaboration on the Social & Moral Psychology of COVID-19\nhttps://icsmp-covid19.netlify.app") +
theme(plot.title = element_text(size = 12, family="Georgia", face = "plain", color="black"),
plot.caption = element_text(color = "#383838", face = "italic", size = 7))))
#dev.off()
}
Figure 7. Cross-cultural differences in Internal Consistency Coefficients of Social & Moral Psychology Constructs in 69 countries.
Figure 7. Cross-cultural differences in Internal Consistency Coefficients of Social & Moral Psychology Constructs in 69 countries.
Figure 7. Cross-cultural differences in Internal Consistency Coefficients of Social & Moral Psychology Constructs in 69 countries.
Figure 7. Cross-cultural differences in Internal Consistency Coefficients of Social & Moral Psychology Constructs in 69 countries.
Figure 7. Cross-cultural differences in Internal Consistency Coefficients of Social & Moral Psychology Constructs in 69 countries.
Figure 7. Cross-cultural differences in Internal Consistency Coefficients of Social & Moral Psychology Constructs in 69 countries.
#save.image(file = "SciData ICSMP.RData")
utils::sessionInfo()
## R version 3.6.0 (2019-04-26)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 19041)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=English_United States.1252
## [2] LC_CTYPE=English_United States.1252
## [3] LC_MONETARY=English_United States.1252
## [4] LC_NUMERIC=C
## [5] LC_TIME=English_United States.1252
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] countrycode_1.3.0 gridExtra_2.3 patchwork_1.1.1 lubridate_1.7.10
## [5] tidytext_0.2.2 extrafont_0.17 ggthemes_4.2.0 rworldmap_1.3-6
## [9] sp_1.3-1 wesanderson_0.3.6 psych_2.1.6 DT_0.16
## [13] forcats_0.5.1 stringr_1.4.0 dplyr_1.0.6 purrr_0.3.4
## [17] readr_1.4.0 tidyr_1.1.3 tibble_3.1.1 ggplot2_3.3.5
## [21] tidyverse_1.3.1
##
## loaded via a namespace (and not attached):
## [1] colorspace_2.0-2 ellipsis_0.3.2 class_7.3-15
## [4] sjlabelled_1.1.6 snakecase_0.11.0 fs_1.5.0
## [7] gld_2.6.2 rstudioapi_0.13 farver_2.1.0
## [10] SnowballC_0.7.0 fansi_0.5.0 mvtnorm_1.1-2
## [13] xml2_1.3.2 mnormt_1.5-6 rootSolve_1.8.2.1
## [16] knitr_1.33 spam_2.3-0 jsonlite_1.7.2
## [19] rJava_0.9-12 broom_0.7.6 Rttf2pt1_1.3.8
## [22] dbplyr_2.1.1 compiler_3.6.0 httr_1.4.2
## [25] backports_1.2.0 assertthat_0.2.1 Matrix_1.2-17
## [28] cli_2.5.0 htmltools_0.5.1.1 tools_3.6.0
## [31] dotCall64_1.0-0 gtable_0.3.0 glue_1.4.2
## [34] lmom_2.8 reshape2_1.4.4 maps_3.3.0
## [37] Rcpp_1.0.7 cellranger_1.1.0 vctrs_0.3.8
## [40] nlme_3.1-139 extrafontdb_1.0 crosstalk_1.1.0.1
## [43] insight_0.14.5 xfun_0.22 xlsxjars_0.6.1
## [46] rvest_1.0.0 mime_0.11 lifecycle_1.0.0
## [49] xlsx_0.6.5 MASS_7.3-51.4 scales_1.1.1
## [52] hms_1.1.0 parallel_3.6.0 expm_0.999-4
## [55] fields_9.9 yaml_2.2.1 Exact_2.1
## [58] stringi_1.7.4 highr_0.9 maptools_1.1-1
## [61] tokenizers_0.2.1 e1071_1.7-2 boot_1.3-22
## [64] rlang_0.4.10 pkgconfig_2.0.3 evaluate_0.14
## [67] lattice_0.20-38 labeling_0.4.2 htmlwidgets_1.5.3
## [70] tidyselect_1.1.1 plyr_1.8.4 magrittr_2.0.1
## [73] R6_2.5.1 DescTools_0.99.38 generics_0.1.0
## [76] DBI_1.0.0 pillar_1.6.2 haven_2.4.1
## [79] foreign_0.8-71 withr_2.4.2 janeaustenr_0.1.5
## [82] modelr_0.1.8 crayon_1.4.1 utf8_1.2.2
## [85] rmarkdown_2.7 grid_3.6.0 readxl_1.3.1
## [88] reprex_2.0.0 digest_0.6.27 xtable_1.8-4
## [91] GPArotation_2014.11-1 munsell_0.5.0 viridisLite_0.4.0